#!/usr/bin/perl

use Counter;
use Fcntl;
use Getopt::Long;

# tool to fix multiple Main addresses
$users = Counter::open(O_RDWR);
$emails = Counter::openfile("email");

# on Aleph, the direct method takes forever at the moment. Dunno why.
$DEBUG = 0;
$method = "having";

GetOptions("method=s" => \$method,
    "debug" => \$DEBUG);
if ($method eq "direct") {
    @reclist = $users->selectany("users.f_key as ukey from users, email where users.email <> email.f_key and users.f_key = email.owner and email.usage = 'main'");
} elsif ($method eq "having") {
    @reclist = $users->selectany("owner as ukey, count(*) as c from email where email.usage = 'main' group by owner having c > 1");
} else {
    die "Method must be direct or having\n";
}
warn "Examining ", @reclist+0, " records\n";

for $keyref (@reclist) {
    $key = $$keyref{ukey};
    $userrec = $users->get($key);
    if (!$userrec) {
	warn "$key: no user record found\n";
	next;
    }
    @emails = $userrec->emails("main");
    if (@emails == 1) {
	my $emailkey = $emails[0]->key();
	if ("\L$emailkey" eq "\L$$userrec{email}") {
	    $DEBUG && warn "$key: no problem\n";
	} elsif ($userrec->{email} =~ /\s+$/) {
	    warn "$key: trailing space in <$$userrec{email}>\n";
	    $userrec->{email} =~ s/\s+$//;
	    $userrec->store();
	} else {
	    warn "$key: singleton: not <$$userrec{email}>\n";
	    $userrec->store();
	}
    } elsif (@emails > 1) {
	warn "$key: ", @emails + 0, " main emails, should be $$userrec{email}\n";
	for $email (@emails) {
	    my $emailkey = $email->key();
	    if ("\L$emailkey" ne "\L$$userrec{email}") {
		warn "$key: Demoting ", $email->key, " to OLD\n";
		$email->{usage} = "old";
		$email->store();
	    } else {
		warn "$key: ", $email->key, " is OK\n";
	    }
	}
    } else { # zero main emails - upgrade
	$email = $emails->get($userrec->{email});
	if ($email->{usage} ne "main") {
	    warn "$key: Promoting ", $email->key, " to MAIN - was $$email{usage}\n";
	    $email->{usage} = "main";
	    $email->store();
	} else {
	    warn "$key: Something strange is going on - no main emailrec!\n";
	}
    }
}
